#|________________________________________________________________
 |
 | graphic1.lsp 
 | contains code for expanded menu-item-template 
 | color and symbol pallet overlay objects
 | and for some of the menu item methods
 | copyright (c) 1999-2003 by Forrest W. Young
 |________________________________________________________________
 |#
 

      
#|___________________________________
 |
 | MENU TEMPLATE ITEM METHODS
 |___________________________________
 |#


(defmeth graph-proto :set-line-width ()
  (send self :ray-line-width (first
        (get-value-dialog "Set Ray Line Width" 
                          :initial (send self :ray-line-width))))
  (send self :linestart-width (iseq (send self :num-lines)) 
        (send self :ray-line-width))
  (send self :redraw)
  )

(defmeth graph-proto :view-selection ()
"Produces a spreadplot for the selected observations in the plot"
  (if (not (send self :statistical-object))
      (error-message "Unknown statistical object")
      (let* ((stat-object (send  self :statistical-object))
             (prev-obs-states (send stat-object :obs-states))
             (obs-states (repeat 'NORMAL (length prev-obs-states)))
             )
        (setf (select obs-states (send self :selection)) 'SELECTED)
        (send stat-object :obs-states obs-states)
        (send stat-object :visualize-data)
        t)))

(defmeth graph-proto :on-top-menu-item (&optional (on-top nil on-top?))
"Arg: &optional on-top
Creates an ALWAYS-ON-TOP menu item. If ON-TOP is T the window is also put in ON-TOP state."
  (let* ((ontop-menu-item 
          (send menu-item-proto 
                :new "Always On Top"
                :action #'(lambda () (do-top-action)))))
    (defun do-top-action ()
      (let* ((graf (send ontop-menu-item :slot-value 'graph)))
         (send graf :always-on-top (not (send graf :always-on-top)))
         (send ontop-menu-item :mark (send graf :always-on-top))))
    (send ontop-menu-item :add-slot 'graph self)
    (when (and on-top on-top?) (send ontop-menu-item :do-action))
	(send ontop-menu-item :mark on-top) ;PV added this line
    ontop-menu-item 
    ))

(defmeth graph-proto :maximize-menu-item (&optional (max nil max?))
"Arg: &optional max
Creates a MAXIMIZE/RESTORE menu item. If MAX is T the window is also put in MAXIMIZED state."
  (let* ((graf self)
         (max-menu-item
          (send menu-item-proto 
                :new "Maximize"
                :action #'(lambda () (do-max-action)))))
    (defun do-max-action ()
        (send graf :zoom-zip (not (send graf :zoom-zip)))
        (send max-menu-item :title (if (send graf :zoom-state) "Restore" "Maximize")))
    (send max-menu-item :add-slot 'graph self)
    (when (and max max?) (send max-menu-item :do-action))
    max-menu-item
    ))

(defmeth graph-proto :pop-out-menu-item (&optional (pop-out nil pop-out?))
"Arg: &optional pop-out
Creates a POP-OUT menu item. If POP-OUT is T the window is also put in POP-OUT state."
  (let* ((pop-out-menu-item 
          (send menu-item-proto 
                :new "Pop Out"
                :action #'(lambda () (pop-out-action)))))
    (defun pop-out-action ()
      (let* ((graf (send pop-out-menu-item :slot-value 'graph)))
         (send graf :pop-put (not (send graf :pop-put)))
         (send pop-out-menu-item :title 
               (if (send graf :pop-put) "Put In" "Pop Out"))))
    (send pop-out-menu-item :add-slot 'graph self)
    (when (and pop-out pop-out?) (send pop-out-menu-item :do-action))
    pop-out-menu-item 
    ))



(defmeth graph-proto :show-plots-menu-item ()
"Arg: none
Creates the SHOW PLOTS a menu item. When graph is Linked the item title is SHOW LINKED PLOTS name, otherwise SHOW CURRENT PLOTS. The item causes all of the (linked) plots associated with the current data object to be shown."
  (let* ((graf self)
         (item (send menu-item-proto 
                     :new "Show Plots"
                     :action #'(lambda () (show-plots) ))))
    (setf *show-linked-plots* item)
    (defun show-plots ()
      (send (send graf :data-object) :show-plots (send graf :linked)))
    (defmeth item :update ()
      (send self :title  (if (send graf :linked) 
                             "Show Linked Plots" 
                             (strcat "Show " 
                                     (string-capitalize (send (send graf :data-object) :name))
                                     " Plots"))))
    item))


(defmeth graph-proto :hide-plots-menu-item ()
"Arg: none
Creates the HIDE PLOTS a menu item. When graph is Linked the item title is HIDE LINKED PLOTS, otherwise HIDE CURRENT PLOTS. The item causes all of the (linked) plots associated with the current data object to be hidden."
  (let* ((graf self)
         (item (send menu-item-proto 
                     :new "Hide Plots"
                     :action #'(lambda () (hide-plots) ))))
    (setf *hide-linked-plots* item)
    (defun hide-plots ()
      (send (send graf :data-object) :hide-plots (send graf :linked)))
    (defmeth item :update ()
      (send self :title  (if (send graf :linked)
                             "Hide Linked Plots" 
                             (strcat "Hide " 
                                     (string-capitalize (send (send graf :data-object) :name))
                                     " Plots"))))
    item))

(defmeth graph-proto :close-plots-menu-item ()
"Arg: none
Creates the CLOSE PLOTS menu item. When graph is linked the item title is CLOSELINKED PLOTS, otherwise CLOSE CURRENT PLOTS. The item causes all of the (linked) plots associated with the current data object to be closed."
  (let* ((graf self)
         (item (send menu-item-proto 
                     :new "Close Plots"
                     :action #'(lambda () (close-plots) ))))
    (setf *close-linked-plots* item)
    (defun close-plots ()
      (send (send graf :data-object) :close-plots (send graf :linked)))
    (defmeth item :update ()
      (send self :title  (if (send graf :linked)
                             "Close Linked Plots" 
                             (strcat "Close " 
                                     (string-capitalize (send (send graf :data-object) :name))
                                     " Plots"))))
    item))



(defmeth graph-proto :quickcluster ()
"Arg: none
Color the points in the plot according to the k-means cluster."
  (quick-cluster 5))

(defun print-plot ()
  (pdf-print))

(defun pdf-print () 
  (when (two-button-dialog (format nil "Print as PDF not yet available.~%Print Bitmap Image Instead?"))
        (mws-print)))

(defun save-plot ()
  (pdf-save))

(defun pdf-save () 
  (when (two-button-dialog (format nil "Save Image as a PDF File not yet available.~%Copy Bitmap Image to ClipBoard Instead?"))
        (mws-copy)))

(defmeth graph-proto :ask-print-pdf ()
  (when (two-button-dialog (format nil "Print as PDF not yet available.~%Print Bitmap Image Instead?"))
        (send self :do-msw-print)))

(defmeth graph-proto :ask-save-pdf ()
  (when (two-button-dialog (format nil "Save Image as a PDF  File not yet available.~%Copy Bitmap Image to Clipboard instead?"))
        (send self :do-msw-copy)))

(defmeth graph-proto :do-msw-print ()
  (msw-print))

(defmeth graph-proto :do-msw-copy ()
  (msw-copy))

      
#|___________________________________
 |
 | MENU TEMPLATE METHODS
 |___________________________________
 |#

(defmeth graph-proto :popup-menu-template ()
  '(showing-labels mouse resize-brush dash 
    erase-selection focus-on-selection view-selection dash
    select-all show-all dash
                   ;k-means
    selection slicer dash
    symbol color dash k-means))

(send graph-proto :menu-template 
      '(help dash new-x new-y dash link dash
        on-top maximize dash print save copy 
            ; k-means
             ))
         
#|
 | MAKE-MENU-ITEM
 |#

(defun menu-symbols ()
      '(dash help new-x new-y new-x link 
             showing-labels mouse resize-brush 
             erase-selection focus-on-selection view-selection 
             select-all show-all 
             selection slicer 
             symbol color 
             show-plot hide-plots close-plots 
             on-top maximize pop-out print save copy 
             save-data create-data redraw rescale options line-width no-items))

(defmeth graph-proto :make-menu-item (item-template)
  (if (kind-of-p item-template menu-item-proto)
      item-template
      (case item-template
        (dash (send dash-item-proto :new))
        (help 
         (send graph-item-proto :new "Help" self :plot-help))
        (new-x
         (send graph-item-proto :new "New X Axis ..." self :new-x))
        (new-y
         (send graph-item-proto :new "New Y Axis ..." self :new-y))
        (new-z
         (send graph-item-proto :new "New Z Axis ..." self :new-z))
        (link (send link-item-proto :new self))
        (showing-labels 
         (send graph-item-proto :new "Show Labels" self
               :showing-labels :showing-labels :toggle t))
        (mouse (send mouse-mode-item-proto :new self))
        (resize-brush 
         (send graph-item-proto :new "Resize Brush" self :resize-brush))
        (erase-selection
         (send graph-item-proto :new "Remove Selection" self 
               :erase-selection :any-points-selected-p))
        (focus-on-selection
         (send graph-item-proto :new "Focus on Selection" self 
               :focus-on-selection :any-points-selected-p))
	(view-selection 
         (send graph-item-proto :new "View Selection" self 
               :view-selection :any-points-selected-p))
        (select-all
         (send graph-item-proto :new "Select All" self
               :select-all-points :all-points-showing-p))
        (show-all
         (send graph-item-proto :new "Show All" self 
               :show-all-points :all-points-showing-p :negate t))
        (symbol
         (let ((symbol-pallet-menu-item (send menu-item-proto :new "Symbol Pallet")))
           (defmeth symbol-pallet-menu-item :do-action ()
             (let* ((menu (send self :menu))
                    (graph (if menu (send menu :graph)))
                    )
               (when graph (send graph :toggle-pallet "symbol")
                     (send self :mark (not (send self :mark))))))
           symbol-pallet-menu-item))
        (color
         (let* ((color-pallet-menu-item (send menu-item-proto :new "Color Pallet")))
           (defmeth color-pallet-menu-item :do-action ()
             (let* ((menu (send self :menu))
                    (graph (if menu (send menu :graph)))
                    )
               (when graph (send graph :toggle-pallet "color")
                     (send self :mark (not (send self :mark))))))
           color-pallet-menu-item))
       ; (k-means (send graph-item-proto :new "K-means" self :quick-cluster))
        
      
        (selection
         (send graph-item-proto :new "Selection ..." self 
               :selection-dialog))
        (slicer
	 (if (not (small-machine-p))
	     (send graph-item-proto :new
		   "Slicer ..." self :make-slicer-dialog)))
       	(show-plots  (send self :show-plots-menu-item))
       	(hide-plots  (send self :hide-plots-menu-item))
       	(close-plots (send self :close-plots-menu-item))
        (on-top      (send self :on-top-menu-item))
        (maximize    (send self :maximize-menu-item))
        (pop-out     (send self :pop-out-menu-item))
        (print
         (send graph-item-proto :new "Print Plot" self :ask-print-pdf))
       	(save
       	 (send graph-item-proto :new "Save Plot As ..." self :ask-save-pdf))
        (copy 
          (send graph-item-proto :new "Copy Plot" self :do-msw-copy))
	(save-data
	  (send graph-item-proto :new "Save Data As ..." self :save-data-as))
	(create-data
	  (send graph-item-proto :new "Create Data Object" self :create-data-object))
        (redraw 
         (send graph-item-proto :new "Redraw Plot" self :redraw))
        (rescale 
         (send graph-item-proto :new "Rescale Plot" self :adjust-to-data))
        (options 
	 (if (not (small-machine-p))
	     (send graph-item-proto :new "Options ..." self :set-options)))
        (line-width
         (send graph-item-proto :new "Ray Line Width ..." self :set-line-width))
        (no-items
	 (send menu-item-proto :new "No Items" :enabled nil))
        )))


(defmeth menu-proto :graph (&optional (objid nil set))
"Args: (&optional objid) objid of graph object for which this is a menu"
  (unless (send self :has-slot 'graph)
          (send self :add-slot 'graph))
  (if set (setf (slot-value 'graph) objid))
  (slot-value 'graph))

(defmeth graph-proto :new-menu (&optional title 
                                     &key (items (send self :menu-template))
                                          (popup-items (send self :popup-menu-template)))
  (if (slot-value 'menu) 
      (send (slot-value 'menu) :dispose))
  (unless title (setq title (slot-value 'menu-title)))
  (flet ((make-item (item) (send self :make-menu-item item)))
    (let ((menu (send menu-proto :new title)))
      (send self :menu menu)
      (when popup-items 
        (send self :make-two-plot-menus title :hotspot-items items :popup-items popup-items))
      (apply #'send menu :append-items  
             (remove nil (mapcar #'make-item items)))
      (send menu :graph self)
      (send menu-proto :new title))))


(defmeth graph-proto :make-two-plot-menus 
  (title &key hotspot-items popup-items)
"Args: TITLE &KEY HOTSPOT-ITEMS POPUP-ITEMS
Makes pull-down and popup menus for plots and plotcells. TITLE is title of the menu if it appears in the menubar. HOTSPOT-ITEMS is the menu items for the pulldown that appears with a left-click on the menubar menu or the pull-down hotspot. POPUP-ITEMS is a set of  menu items that popup from the plot when the plot is right clicked."
  (send self :make-hotspot-menu-items hotspot-items) ;store items in a slot
  (send self :make-popup-menu-items popup-items)  ;create secondary items, store in slot
	(when (send self :menu)
  (send (send self :menu) :remove) ) ;remove menu from menubar so it can be popped up PV added (when (send self :menu) here and below
  (defmeth self :do-click (x y m1 m2)
   
    (let* ((menu (send self :menu))
           (hotspot-menu-items (send self :hotspot-menu-items)) 
           (popup-menu-items (send self :popup-menu-items)))
      (cond
       ((and m2 (send self :menu));PV was m2
        (when (and popup-menu-items (> y 18))
              (apply #'send menu :delete-items (send menu :items))
              (apply #'send menu :append-items popup-menu-items)
              (send menu :popup-menu x y self)
              (send self :menu menu)))
        (t 
         (when (send self :menu) 
               (send menu :remove)
               (apply #'send menu :delete-items (send menu :items))
               (apply #'send menu :append-items hotspot-menu-items))
         (call-next-method x y m1 m2)
         (send self :menu menu)))
      t)
  (when (send self :menu)
        (send (send self :menu) :graph self)
        (send (send self :menu) :remove))
  (send self :menu)))

(defmeth graph-proto :make-popup-menu-items (items)
  (send self :popup-menu-items
        (mapcar #'(lambda (item) 
                    (send self :make-menu-item item))
                items)))

(defmeth graph-proto :make-hotspot-menu-items (items)
  (send self :hotspot-menu-items
        (mapcar #'(lambda (item) 
                    (send self :make-menu-item item))
                items)))

(defmeth graph-proto :popup-menu-items (&optional (obj-list nil set))
  (unless (send self :has-slot 'popup-menu-items)
          (send self :add-slot 'popup-menu-items))
  (if set (setf (slot-value 'popup-menu-items) obj-list))
  (slot-value 'popup-menu-items))

(defmeth graph-proto :hotspot-menu-items (&optional (obj-list nil set))
  (unless (send self :has-slot 'hotspot-menu-items)
          (send self :add-slot 'hotspot-menu-items))
  (if set (setf (slot-value 'hotspot-menu-items) obj-list))
  (slot-value 'hotspot-menu-items))


(defmeth graph-proto :append-always-on-top-menu-item (&optional (on-top nil on-top?))
"Arg: &optional on-top
Appends an ALWAYS-ON-TOP menu item to the window's menu. If ON-TOP is T the window is also put in ON-TOP state."
  (send (send self :menu) :append-items (send self :on-top-menu-item on-top)))

(defmeth graph-proto :append-maximize-restore-menu-item (&optional (max nil max?))
"Arg: &optional max
Appends a MAXIMIZE/RESTORE menu item to the window's menu. If MAX is T the window is also put in MAXIMIZED state."
  (send (send self :menu) :append-items (send self :maximize-menu-item)))


